perm filename MOVER.OLD[NEW,LCS]2 blob sn#152170 filedate 1975-03-23 generic text, type T, neo UTF8
00100	C******  MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
00200		SUBROUTINE MOVER
00300		IMPLICIT INTEGER(A-Q,S-Z)
00400		DIMENSION R(2,200),IR(2,200)
00500		REAL PWDS,POS,EXTEN,PRCNT
00600		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(-3/4),RSTJ2
00700		COMMON/XRN/RN(4000)  /KJY/ K,JY
00800		COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
00900		COMMON/POSI/STFF(-3/4),JJ2,POS/PTR/PWDS(250),ITEM,LL,I,IX
00910		COMMON/ALF/INP(47),ML,RRT,RZRO,RCNT,RJSZ,ROV,RSPC,KN,RA,RB,
00920		1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
01000	      EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
01100		1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
01200		1,(IR,R,RN(3101))
01300		DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/
01400	
01500		JJ2=-1
01700		J2=0
01710		ASK=-1
01800	C  99=BACKUP
01900	6	CALL VLINE(R2,R4,R5,R6)
02000		IF(R2.GE.99)RETURN
02100		IF(INP(1).NE.'J')GO TO 12
02200		RRT=R5
02300		RZRO=R4
02400		IF(RRT.EQ.0)RRT=200
02500		IF(RZRO.EQ.0)RZRO=.001
02600		RCNT=0
02700		RJSZ=RI
02710		ML=1
02720		ROV=RRT
02730		PRCNT=1.
02900		R7=R2
03000		R6=0
03100		R11=0
03200	19	IF(RCNT.GT.9)GO TO 101
03400		RJSZ=RJSZ-.06
03410		RP=PRCNT
03500		RCNT=RCNT+1
03600	C  TEMPORARY COUNTER
03800		TYPE F78F,RCNT
03900	
04000		DO 11 KN=-3,4
04100		RSPC=0
04200		R8=KN
04300		N=0
04310	
04400		DO 2 K=1,ITEM
04500		L=PWDS(K)
04600		IF(RTLINE(L))GO TO 2
04700		RA=RN(L+1)
04800		RB=RN(L+3)
04850		IF(RB.LT.RZRO)GO TO 2
04900		IF(RN(L+2).EQ.R8)GO TO 77
05000		IF(RA.NE.4)GO TO 2
05200	C  SKIPS HOMED NOTES (IN CHORDS)
05300	77	IF(RA.EQ.1)GO TO 10
05400	27	IF(RA.LE.4)GO TO 177
05425		IF(RA.LT.17)GO TO 2
05450	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
05500	177	IF(RA.NE.4)GO TO 10
05550		IF(RN(L).GT.2)GO TO 2
05600	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
05700	10	N=N+1
05800		R(1,N)=RB
05900		IR(2,N)=L
06000		IF(N.EQ.200)GO TO 28
06100	C  ONLY TREATS 200 ITEMS AT A TIME.
06200	2	CONTINUE
06210	
06300		IF(N.EQ.0)GO TO 11
06400	28	DO 23 K=1,N
06500	23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
06600	C  SKIPS IF ONLY BAR LINES ON THIS STAFF
06700		GO TO 11
06800	24	RSTJ2=RSTFAC(KN)*PRCNT
07000		CALL SORT2(R,N)
07100	
07200	C  JUMP IF LAST IS A BAR LINE.
07300		K=0
07310		JLDGR=0
07400	     	JX=0
07500	22	K=K+1
07600	122	L=IR(2,K)
07700		RA=RN(L+1)
07800		RB=0
07900		RX=RN(L+5)
07950	C  RX=PARAM 5
07975		RX6=RN(L+6)
08000		RY=1
08100		RW=AMOD(RN(L+4),100.)
08200		IF(RA.GT.1)GO TO 4
08300		RZ=RN(L+7)
08325		IF(LDGR.NE.JLDGR)JLDGR=0
08350		LDGR=0
08400		JY=K
08500		DO 32 JJ=JY+1,N+1
08550		K=JJ
08600	32	IF(R(1,JJ)-R(1,JJ-1).GT.RSP)GO TO 35
09000	C  FOUND HOW MANY MEMBERS TO CHORD.
09400	35	RB=0
09450		K=K-1
09500		RQ=0
09600		RD=0
09700	125	IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
09800		DO 37 JJ=JY,K-1
09850		IF(RD.NE.0)GO TO 38
09875	C FINDS ONLY HIGH OR! LOW LED. LINE.
09887		JR=IR(2,JJ)
09900		RW=AMOD(RN(JR+4),100.)
10000		IF(RW.GT.11)GO TO 277
10025		IF(RW.GE.2)GO TO 38
10050	277	LDGR=-1
10100		IF(RW.GT.11)LDGR=1
10150		IF(JLDGR.EQ.LDGR)GO TO 36
10187		JLDGR=LDGR
10200	C LDGR IS FOR LEDGER LINES.
10225		GO TO 38
10260	36	RD=1.5
10270		RQ=RD
10300	38	IF(RB.GT.2)GO TO 222
10400	C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
10500		RZZ=RN(JR+7)
10600		RE=RN(JR+5)
10700	CC	IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
10800	CC	1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
10805		IF(RB.GE.2)GO TO 477
10810		IF(RZZ.GE.10)GO TO 377
10820		IF(RE.GE.20)GO TO 477
10830		IF(AMOD(RZZ,10.).EQ.0)GO TO 477
10890	377	RB=1.5+EXTEN(RZZ)
10900	C  SPACE FOR DOT OR TAIL(IF STEM UP)
11000	477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
11100	C  FOR CHORD TONES ON RIGHT OF STEM UP.
11200	C  LOOKS THROUGH ALL NOTES OF A CHORD.
11300	222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
11400	C  JUMP IF NO ACCIS.
11500	425	RD=2*RY+EXTEN(RE)
11600		IF(RQ.GT.RD)RD=RQ
11700		RQ=RD
11800	C  FUNCT. EXTEN=AMOD(X,1.)*10.
11900	37 	CONTINUE
12000		IF(RY.NE.1)RB=RB-.5*RJSZ
12100	C  MINI NOTES NEED LESS SPACE
12600	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
12700		GO TO 17
12800	4	IF(RA.NE.3)GO TO 29
12900		RB=3
13000		IF(RX.GT.100)RB=1.5
13100	C  CHECK ON SIZE NEEDED FOR CLEFS
13200	29	IF(RA.NE.4)GO TO 26
13300		RB=-RJSZ/2
13400		RD=.9
13500		GO TO 25
13600	26	IF(RA.NE.18)GO TO 30
13700		IF(RX6.GT.9)GO TO 31
13705		IF(RX.GT.9)GO TO 31
13710	C  CHECKS FOR 2-DIGIT METERS
13800		RB=-1
13900		RD=1
14000		GO TO 25
14100	31	RB=2
14200		RD=3
14300		GO TO 25
14400	30	IF(RA.NE.17)GO TO 17
14455		RB=2*(ABS(RX)-1)-2
14460	C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
14475		RD=2
14487		GO TO 25
14700	17	RC=(RB+RJSZ)*RSTJ2
14800	C  RJSZ=DEFAULT SIZE
14900		JX=JX+1
15000		R(2,JX)=RC
15100		R(1,JX)=R(1,K)
15200	3	IF(K.LT.N)GO TO 22
15300		RA=R(1,1)
15400		RB=R(2,1)
15500	
15600		DO 13 KX=2,JX
15700		RE=R(1,KX)
15800	C  POS. BEFORE SHIFTING
15900		IF(ABS(RE-RA).GT..5)GO TO 14
16000		IF(R(2,KX).GT.RB)GO TO 16
16100	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
16200		GO TO 13
16400	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
16600	14	RD=RA+RB-RE
16700		IF(RD.LE.0)GO TO 16
16800	C  THERE'S ENOUGH ROOM
17000		R4=RE+RSPC-.001
17100		R5=1000
17200		R8=RD
17300		R9=0
17400		RSPC=RSPC+RD
17500	C  RSPC SAVES TOTAL SPACE ADDED
17600	C  GO EXPAND IT
17700		IF(R(2,KX).NE.0)GO TO 166
17800	16	RB=R(2,KX)
17900	13	RA=RE
18000	11	CONTINUE
18100	110	IF(ROV.LE.RRT+.01)GO TO 18
18110		IF(RJSZ.GT.4)RJSZ=4
18120		PRCNT=(ROV-RZRO)/(RRT-RZRO)
18160	CC	RP=RJSZ/(RJSZ-.1)
18180		IF(PRCNT.NE.RP)GO TO 19
18190	C  GO BACK AND EXPAND SOME MORE
18200		R4=RZRO
18300		R5=ROV
18400		R8=RZRO
18500		R9=RRT-.001
18600	C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
18700		ML=2
18900		GO TO 66
19000	18	ML=3
19100		R8=RRT-ROV
19200	CC	R9=RRT+2
19250		R9=0
19300	C  GOES BACK TO PICK UP DANGLING ITEMS(BEYOND RRT)
19400		R4=RRT
19500		R5=1000
19600	166	JJ2=-1
19700		J2=0
19710	266	IF(RCNT.EQ.1)RVX=ROV+2
19755	C  RVX SHOULD BE FARTHEST POINT TO RIGHT.
19800		GO TO 66
19850	1200	FORMAT(' MOVED TO STAFF ',F4.0/)
19860	C******  BEGIN MOVER *******
19900	12	TYPE 5
20000		ML=4
20100		ACCEPT F78F,R7,R8,R9,R11
20110		RDIS=0
20200		REREAD FA1,L
20300	C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
20305		IF(R2.NE.88)GO TO 167
20320	C  88, 1ST ITEM, LAST ITEM:   STAFF N, MOVE HOR., MOVE VERT.
20330		LDGR=R5
20335		J2=R4-1
20340	C  1ST ITEM.
20345		R4=-500
20350		R5=500
20355		L=I
20357	C  ↑↑↑↑ FOR 'C'OPY
20360	168	IF(J2.GT.LDGR)GO TO 101
20365		JY=PWDS(J2+1)
20367		IF(INP(1).NE.'C')L=JY
20370		GO TO 6551
20375	
20400	167	IF(R7.GE.99)GO TO 6
20410		IF(R7.NE.R2)TYPE 1200,R7
20420		IF(R2.GT.4)R7=R2
20430		IF(R11.LT.100)GO TO 1201
20440		R11=R11-100.
20450		ASK=0
20500	1201	IF(L.NE.'L')GO TO 66
20600		DO 67 K=1,2
20700		R8=RY
20800		CALL LPEN(R7,RY,RX)
20900	67	IF(R7.GE.99)GO TO 6
21000		R9=RY
21010	
21100	66	JY=1
21200		L=JY
21300		IF(INP(1).EQ.'C')L=I
21400	C  C=COPY
21600		IF(R9.NE.0)RDIS=(R9-R8)/(R5-R4)
21700	
21800	6551	RB=RN(JY)
21900		J2=J2+1
22000		IF(RTLINE(JY))GO TO 7551
22100	C  IF STAFF#>4, ALL STAVES ARE MOVED.
22200		RA=RN(JY+1)
22300		IF(R6.LE.0)GO TO 577
22310		IF(R6.NE.RA)GO TO 7551
22400	C SKIPS IF NOT SPECIAL CODE NUM.
22500	577	RN3=RN(JY+3)
22600		IF(RN3.GT.R5)GO TO 7551
22700		RC=-1
22800		RD=0
22900		IF(RA.LT.5)GO TO 677
22910		IF(RA.LE.7)RD=-1
23000	677	IF(RA.EQ.4.)GO TO 777
23010		IF(RD)GO TO 777
23020		IF(RN(JY+5).NE.50)GO TO 877
23030	777	RC=0
23100	C RC=0 FOR CODES 4,5,6
23200	877	RN6=RN(JY+6)
23300		IF(RN3.GE.R4)GO TO 8
23400	      IF(RC)GO TO 7551
23410		IF(RC.NE.0)GO TO 8
23420		IF(RN6.LE.R4)GO TO 7551
23430		IF(RN6.GE.R5)GO TO 7551
23500	C RIGHT SIDE IS BEFORE OR AFTER MOVE AREA.
23600	C  IF INP(1)='C' MOVE TO NEW SPOT AND LEAVE OLD BEHIND.
23700	8	IF(ASK)GO TO 100
23800		CALL ASKIT
23900		IF(K.EQ.'N')GO TO 7551
24000		IF(K.EQ.'X')GO TO 1
24100	C  'X'=EXIT
24200	C  N=NO, <CR>=YES
24300	100	IF(INP(1).NE.'C')GO TO 9551
24400		K=RB+2
24500		CALL LOOP(0,K,1,L,JY,RN)
24600		ITEM=ITEM+1
24700		IF(JJ2)JJ2=ITEM
24800	C  JJ2 SAVES ITEM # FOR MAIN PROG.
24900		PWDS(ITEM+1)=L+K+1
25000	9551	IF(JJ2)JJ2=J2
25100	C   (50=CRESC., DECRESC.)
25200		IF(R2.LT.5)GO TO 977
25205		IF(R2.NE.88.)GO TO 771
25210	977	RN(L+2)=R7
25300	771	IF(RA.EQ.8)GO TO 7552
25350	C 8=STAFF. ONLY MOVES OR COPIES TO NEW STAFF NUM. OTHER PARAMS UNAFFECTED.
25400		RQ6=RN6-R5
25500		RX=0
25510		RV=0
25600		IF(RA.NE.6)GO TO 21
25610		IF(RB.LT.7)GO TO 21
25700		RX=RN(L+9)
25800		RY=RX-R5
25900		RZ=R4-RX
25930		IF(RN(L+10).LT.30)GO TO 221
25940		RW=RN(L+8)
25950		IF(RW.LT.R4)GO TO 221
25960		IF(RW.LE.R5)RV=-1
26000	221	IF(RY.GE.0)GO TO 21
26010		IF(RZ)RX=-1
26100	C PARTIAL BEAM IS WITHIN MOVE AREA.
26200	21	IF(R9.EQ.0)GO TO 2551
26350		IF(RN3.GE.R4)CALL MVBX(3)
26375	C  MOVES P4 LFT-RT.   ↑↑↑↑↑↑↑↑
26400		IF(RC)GO TO 7552
26500		IF(RA.NE.4.)GO TO 772
26510		IF(RB.LT.4)GO TO 7552
26610	772	IF(RQ6)CALL MVBX(6)
26700	C  END POINT OUTSIDE OF MOVE RANGE NOT AFFECTED.
26800		IF(RA.NE.6)GO TO 7552
26900		IF(RX)CALL MVBX(9)
26910		IF(RV)CALL MVBX(8)
27000	C  ONLY TRUE WHEN RA=6
27100		GO TO 7552
27200	
27300	2551	IF(RN3.GE.R4)RN3=RN3+R8
27400		RN(L+3)=RN3
27500	      IF(RQ6.GE.0)GO TO 773
27510		IF(RD)GO TO 774
27520		IF(RA.NE.4)GO TO 773
27530		IF(RB.LE.3.)GO TO 773
27540	774	RN(L+6)=RN(JY+6)+R8
27600	773	IF(RX)CALL MVBEAM(RN,9,JY,L,R8)
27610		IF(RV)CALL MVBEAM(RN,8,JY,L,R8)
27700		IF(RN3.GT.ROV)ROV=RN3
27800	C ??? NOT YET FIXED FOR ENDS OF SLURS OR LINES
27900	7552	L=RB+3+L
28000		IF(R11.EQ.0)GO TO 7551
28160	1151	IF(RA.EQ.8)GO TO 7551
28170		IF(RA.EQ.18)GO TO 7551
28180		IF(RB.GE.3)GO TO 775
28190		IF(RA.EQ.9)GO TO 775
28195		IF(RA.NE.11)GO TO 7551
28200	C  'U-D' SKIPS METER, STAFF, KEY SIG., ETC. ???CHECK ABOVE↑↑↑↑↑↑↑↑
28300	775	JX=JY
28400		IF(INP(1).EQ.'C')JX=PWDS(ITEM)
28550		CALL MVBEAM(RN,4,JX,JX,R11)
28560		IF(RC.EQ.0)CALL MVBEAM(RN,5,JX,JX,R11)
28700	7551	JY=RB+3+JY
28800		IF(INP(1).NE.'C')L=JY
28850		IF(R2.EQ.88)GO TO 168
28900		IF(JY.LT.I)GO TO 6551
29000		GO TO (16,18,101,1),ML
29100	101	JJ2=1
29200	1	CALL HYDPOG(3)
29300	5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
29400		END
29500	
29600	CC	FUNCTION RTLINE(L)
29700	CC	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
29800	CC	RTLINE=-1
29900	CC	IF(R2.GT.4)GO TO 1
29910	CC	IF(RN(L+2).NE.R2)RETURN
29920	CC1	RTLINE=0
30000	CC	END
30100	
30200	CC	FUNCTION EXTEN(X)
30300	CC	EXTEN=AMOD(X,1.)*10.
30400	CC	END
30500	
30550	C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
30600	CF	SUBROUTINE MVBEAM(R,I,JY,L,W)
30650	C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
30700	CF	DIMENSION R(1)
30710	CF	Y=R(JY+I)
30720	CF	Z=ABS(Y)
30730	CF	IF(Z.LT.100.)GO TO 1
30740	C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
30750	CF	Y=AMOD(Y,100.)
30755	CF	X=Y+W
30760	CF	Z=Z-ABS(Y)+ABS(X)
30770	C  PUTS ALL INTO POSITIVE
30780	CF	IF(X)Z=-Z
30790	CF	GO TO 2
30795	CF1	Z=Y+W
30800	CF2	R(L+I)=Z
30900	CF	END
31000	
31100	CF	SUBROUTINE MVBX(I)
31110	CF    COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
31210	CF	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
31300	CF	R(L+I)=R8+(R(JY+I)-R4)*RDIS
31400	CF	END
31500	
31600		SUBROUTINE CLEFS
31700	      DIMENSION JCLEF(11),MCLEF(700),RCMIN(4),KCLEF(11),NCLEF(350),CM(4)
31800		COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS
31900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
32000	      DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
32100		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
32200	     1 KCLEF(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
32300		1,(R9,RJQ(7)),(NJR,RJQ(8)),(K,JCLEF(11)),(NCLEF,MCLEF(351))
32350		1,(R3,RJQ(1))
32400		J5=MOD(J5,100)
32600		CALL NOZERO(R6)
32700		IF(R7.EQ.0)R7=R6
32800	C  IF P7 = 0, IT WILL EQUAL P6.
32900		IF(JA.GT.10)GO TO 9
33000		NAME='CLEF0'
33100		IF(J5.LT.20)GO TO 4
33200		R6=R6*.3
33300	C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
33400		R7=R7*.3
33500		GO TO 4
33600	9	IF(NAME.EQ.NJR)GO TO 4
33700		IF(NAME.EQ.0)GO TO 177
33710		IF(NJR.EQ.0)GO TO 4
33800	177	IF(NJR.EQ.0)GO TO 8	
33900	C  TO PICK UP BASIC DRAW NAME FROM P10 
34000		NAME=NJR
34100		GO TO 4
34200	8	TYPE 5
34300	5	FORMAT(' SET P10=1'/)
34400	C  LEADS TO PROPER FILE CALL
34500	4	NM=NAME+2*(J5/10)
34600	C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
34700		JEZ=MOD(J5,10)+1
34800	2	IF(NM.EQ.JNM)GO TO 30
34810		IF(NM.EQ.KNM)GO TO 30
34900	C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
35000	C  JUMP IF ALREADY IN CORE
35100		IF(LOOKF(NM))GO TO 1111
35200		TYPE 1112,NM
35300		RETURN
35400	1112	FORMAT(1XA5,' -- NOT FOUND')
35500	1111	CALL GETFI2(NM)
35600		IF(KX)GO TO 33
35700		KX=-1
35800		JNM=NM
36200		CALL FASTI2(JCLEF,11)
36300		CALL FASTI2(MCLEF,K)
36400	C  NEW DATA READER  6/74 -- 10/74 HOLDS 2 .DMD FILES IF THEY FIT.
36500		IF(K.LE.350)GO TO 30
36600		KX=0
36700		KNM=0
36800		GO TO 30
36900	33	CALL FASTI2(KCLEF,11)
37000		KX=0
37100		IF(KK.GT.350)GO TO 1111
37200	C  JUMP BACK IF IT WON'T FIT.
37300		CALL FASTI2(NCLEF,KK)
37400		KNM=NM
37600	C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
37700	C  R6 IS SIZE FACTOR
37800	30	IF(J5.GT.3)GO TO 811
37810		IF(JA.NE.3)GO TO 811
37900	C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
38100	C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
38200		IF(R5.LT.100)GO TO 812
38300		RSTJ2=.8*RSTJ2
38500	C  TO SET HGT. OF MINI CLEFS
38510		R4=R4+CM(JEZ)
38520	C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
38600	812	IF(JEZ.NE.4)GO TO 811
38800		R4=R4+2
38900		JEZ=3
39000	C   ABOVE IS NOW AT TOP
39100	
39200	811	A=R4
39300		R4=A+2.9
39400		CALL CENTX
39500		R4=A
39600	
39800		L=JCLEF(JEZ)
39900		IF(NM.EQ.KNM)L=KCLEF(JEZ)+350
40000		IF(J9.EQ.0)GO TO 31
40100		CALL ROTATE(MCLEF,L)
40200	C  R9=P9=DEGREES OF ROTATION (0-360)
40300		IF(KK.GT.250)KX=0
40400	C CHECK TO SEE IF DATA WAS WIPED OUT.
40500	31	IF(R8.EQ.-2)GO TO 32
40505		IF(IPLT)GO TO 77
40510		IF(R8.NE.-1)GO TO 32
40600	C			R8=-2 OMITS FILLER DURING PLOT
40700	77	DO 3 K=L+1,MCLEF(L)+L
40800		IF(MCLEF(K).LT.200000000)GO TO 3
40900		JEZ=MCLEF(L)-1
41000		IF(K.GT.L+1)JEZ=JEZ-K+L+1
41100		CALL FILLMS(JEZ,MCLEF(K),R3,CENTR,R6,R7)
41105		GO TO 32
41110	3	CONTINUE
41155	C  FILLS ONLY WHEN PLOTING OR R8=-1
41200	32	CALL JDRAW(MCLEF(L),R3,CENTR,RSTJ2,R6,R7)
41300	C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
41400	
41800		END